home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
076-100
/
disk_084
/
gravitywars
/
gw.mod
< prev
next >
Wrap
Text File
|
1992-05-06
|
13KB
|
409 lines
IMPLEMENTATION MODULE GW;
(*+,+*)
(**********************************************************************
*************** Written by Ed Bartz ***************
*************** Copyright 5/21/87 ***************
*************** This program may be redistributed ***************
*************** or modified as long as these ***************
*************** notices and all other references ***************
*************** to the author remain intack. ***************
*************** Also this may not be used for ***************
*************** profit by anyone without the ***************
*************** express permission of the author. ***************
**********************************************************************)
FROM SYSTEM IMPORT ADR, BYTE, ADDRESS, NULL, WORD;
FROM Areas IMPORT AreaInfo, AreaInfoPtr, AreaEllipse, AreaEnd, InitArea;
FROM Intuition IMPORT
IntuitionName, IntuitionBase, Window, WindowFlags, NewWindow,
MenuPick, IDCMPFlagSet, WindowFlagSet, WindowPtr, ScreenPtr, Screen,
MenuEnabled, MenuFlagSet, Menu, MenuItem, IntuitionText, ActiveWindow,
ItemFlagSet, ItemText, ItemEnabled, IntuiMessagePtr, CustomScreen ;
FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, Jam2, Jam1,
DrawingModeSet, BitMapPtr, BitMap, PlanePtr;
FROM Windows IMPORT OpenWindow, CloseWindow;
FROM Screens IMPORT NewScreen, OpenScreen, CloseScreen, ShowTitle;
FROM RandomNumbers IMPORT Random;
FROM MathLib0 IMPORT arctan,pi,real,entier,sin,cos,DegToRad,sqrt,power;
FROM Rasters IMPORT SetRast, RastPort, RastPortPtr, TmpRas, InitTmpRas,
AllocRaster, FreeRaster;
FROM Views IMPORT ModeSet;
FROM Console IMPORT
OpenWConsole,CloseWConsole,PutChar,PutStr,GetChar,GetStr,Conport;
FROM M2Conversions IMPORT ConvertReal, ConvertToReal;
FROM Pens IMPORT Draw, Move,SetAPen,SetDrMd,ReadPixel,WritePixel;
FROM InOut IMPORT WriteLn,WriteString;
FROM MyWindow IMPORT ReadMenu;
PROCEDURE Min (x,y :INTEGER) :INTEGER;
BEGIN
IF x < y THEN RETURN x;
ELSE RETURN y;
END;
END Min;
(***********************************************************************)
PROCEDURE Max (x,y :INTEGER) :INTEGER;
BEGIN
IF x > y THEN RETURN x;
ELSE RETURN y;
END;
END Max;
(***********************************************************************)
PROCEDURE Sdrwline(x1,x2,y1,y2: INTEGER;color: CARDINAL;wp: WindowPtr);
VAR
i,j,k,l,m : INTEGER;
c1,c2 : CARDINAL;
BEGIN
i:= ABS(y2-y1) DIV 3;
IF i>0 THEN
l:=Min(y1,y2);
j:= i + l;
FOR m:= 0 TO 2 DO
c2:=CARDINAL(j-l);
FOR k:= l TO j DO
c1:= Random(c2);
IF c1<(CARDINAL(k-l)) THEN c1:=1;ELSE c1:=0;END;
SetAPen (wp^.RPort,color+c1);
WritePixel(wp^.RPort,k,x2);
WritePixel(wp^.RPort,k,x1);
END;
l:=j;
j:=j+i;
color:= color+1;
END;
DrawLine(l,x2,Max(y1,y2),x2,color,wp);
DrawLine(l,x1,Max(y1,y2),x1,color,wp);
ELSE
DrawLine(y1,x1,y2,x1,color,wp);
DrawLine(y1,x2,y2,x2,color,wp);
END;
END Sdrwline;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE DrawPlanet(x,y,r:INTEGER;color,ptype: CARDINAL;wp: WindowPtr);
CONST
round = 0.83;
VAR
r1,itr,nx,ny,x1,x2,y1,y2 :INTEGER;
BEGIN
IF color>3 THEN
IF ptype = 1 THEN
r1:=entier(real(r)*round);
itr := r1*r1;
FOR ny := 0 TO r1 DO
nx:=entier(sqrt(real(itr-ny*ny))/round);
x1:= x-nx;
x2:= x+nx;
y1:= y-ny;
y2:= y+ny;
IF x1<0 THEN x1:=0; END;
IF y1<0 THEN y1:=0; END;
IF x2>639 THEN x2:=639; END;
IF y2>399 THEN y2:=399; END;
Sdrwline(y1,y2,x1,x2,color,wp);
END;
ELSE
itr := r*r;
FOR nx := 0 TO r DO
ny:=entier(sqrt(real(itr-nx*nx))*round);
x1:= x-nx;
x2:= x+nx;
y1:= y-ny;
y2:= y+ny;
IF x1<0 THEN x1:=0; END;
IF y1<0 THEN y1:=0; END;
IF x2>639 THEN x2:=639; END;
IF y2>399 THEN y2:=399; END;
DrawLine(x1,y1,x1,y2,color+2,wp);
DrawLine(x2,y1,x2,y2,color+2,wp);
END;
END;
END;
IF color<2 THEN
itr := r*r;
FOR nx := 0 TO r DO
ny:=entier(sqrt(real(itr-nx*nx))*round);
x1:= x-nx;
x2:= x+nx;
y1:= y-ny;
y2:= y+ny;
IF x1<0 THEN x1:=0; END;
IF y1<0 THEN y1:=0; END;
IF x2>639 THEN x2:=639; END;
IF y2>399 THEN y2:=399; END;
DrawLine(x1,y1,x1,y2,0,wp);
DrawLine(x2,y1,x2,y2,0,wp);
END;
END;
END DrawPlanet;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Distance(A,B :Pl):INTEGER;
VAR
i : INTEGER;
m,l,k,n : REAL;
BEGIN
m:=real(ABS(A.x-B.x));
k:=real(ABS(A.y-B.y))/0.83;
IF m <= 0.0 THEN m:=0.01;END;
IF k <= 0.0 THEN k:=0.01;END;
l:=sqrt(m*m+k*k);
i:=ABS(entier(l));
RETURN i;
END Distance;
(*++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Pposition (VAR PlanetPos: ARRAY OF Pl;Pnum,ptype: CARDINAL; w: WindowPtr);
VAR
i,j,k,Stop1,Stop2 :INTEGER;
Ok:BOOLEAN;
r3 : REAL;
density : CARDINAL;
mass : ARRAY [0..2] OF REAL;
BEGIN
mass[0] := 0.020;
mass[1] := 0.025;
mass[2] := 0.030;
Stop1:=0;
Stop2:=0;
i:=0;
WHILE i<INTEGER(Pnum) DO
WITH PlanetPos[i] DO
x := Random(519)+60;
y := Random(299)+50;
r := Random(40)+10;
END;
Ok:= TRUE;
j:=i-1;
WHILE ((j>=0)AND Ok) DO
k:=Distance(PlanetPos[i],PlanetPos[j]);
k:=k-PlanetPos[i].r-PlanetPos[j].r;
IF k<20 THEN
Ok := FALSE;
END;
j:=j-1;
END;
Stop1:= ReadMenu(w);
IF Stop1 = 1 THEN Stop2:= 1; END;
IF Ok THEN
WITH PlanetPos[i] DO
r3:=real(r);
r3:=r3*r3*r3;
density:= Random(3);
color := (density*4)+4;
m := r3* mass[density];
IF Random(50)>47 THEN
color := 0;
m := r3* mass[2];
END;
IF Stop2 = 0 THEN DrawPlanet(x,y,r,color,ptype,w); END;
END;
i:=i+1;
END;
END;
END Pposition;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Sposition(w: WindowPtr;VAR Ship,PPos: ARRAY OF Pl;Pnum: CARDINAL);
VAR
k,m : CARDINAL;
i,j,l : INTEGER;
Ok : BOOLEAN;
BEGIN
FOR k:= 0 TO 1 DO;
Ship[k].r := 18;
REPEAT
m:=k*460+40;
Ship[k].y :=Random(300)+50;
Ship[k].x :=Random(100)+m;
Ok:=TRUE;
i:=0;
WHILE ((i<INTEGER(Pnum))AND Ok) DO
j:=Distance(Ship[k],PPos[i]);
IF j<PPos[i].r+40 THEN
Ok:=FALSE;
END;
i:=i+1;
END;
UNTIL Ok;
END;
DrawShip(Ship[0].x,Ship[0].y,Ship[1].x,Ship[1].y,w);
END Sposition;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Stars(wp: WindowPtr);
VAR
i,x,y,c : CARDINAL;
BEGIN
FOR i:= 0 TO 500 DO
x :=Random(639);
y :=Random(399);
SetAPen(wp^.RPort,1);
WritePixel(wp^.RPort,x,y);
END;
END Stars;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Sexplosion(mis:Shell;wp: WindowPtr);
VAR
i,j,k,x,y,x1,y1 : CARDINAL;
BEGIN
FOR i:=0 TO 50 DO
j:= (i DIV 5)+5;
k:= j * 2;
x:= (CARDINAL(mis.x) - j)+Random(k) ;
y:= (CARDINAL(mis.y) - j)+Random(k) ;
SetAPen(wp^.RPort,2);
WritePixel(wp^.RPort,x,y);
END;
FOR i:=0 TO 500 DO
j:= (i DIV 25)+5;
k:= j * 2;
x:= (CARDINAL(mis.x) - j)+Random(k) ;
y:= (CARDINAL(mis.y) - j)+Random(k) ;
x1:= (CARDINAL(mis.x) - 5)+Random(10) ;
y1:= (CARDINAL(mis.y) - 5)+Random(10) ;
k:= Random(3);
SetAPen(wp^.RPort,0);
WritePixel(wp^.RPort,x1,y1);
SetAPen(wp^.RPort,k);
WritePixel(wp^.RPort,x,y);
END;
END Sexplosion;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Pexplosion(mis:Shell;wp: WindowPtr);
VAR
debry : ARRAY [0..2],[0..20] OF CARDINAL;
i,j,k,l : CARDINAL;
BEGIN
l:=0;
i:=0;
WHILE ((l<20)AND(i<100)) DO
j:= 10*(1+(i DIV 50)) + (l DIV 4);
k:= j * 2;
debry[0,l]:= (CARDINAL(mis.x) - j)+Random(k) ;
debry[1,l]:= (CARDINAL(mis.y) - j)+Random(k) ;
debry[2,l]:= ReadPixel(wp^.RPort,debry[0,l],debry[1,l]);
IF debry[2,l]=0 THEN
SetAPen(wp^.RPort,2);
WritePixel(wp^.RPort,debry[0,l],debry[1,l]);
l:=l+1;
END;
i:=i+1;
END;
FOR i:=0 TO l DO
SetAPen(wp^.RPort,debry[2,i]);
WritePixel(wp^.RPort,debry[0,i],debry[1,i]);
END;
END Pexplosion;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE DrawLine (x1,y1,x2,y2,c : CARDINAL; wp : WindowPtr);
BEGIN
WITH wp^ DO
SetAPen (RPort,c); SetDrMd (RPort, Jam1);
Move (RPort ,x1, y1); Draw (RPort , x2, y2);
END
END DrawLine;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE DrawShip(x1,y1,x2,y2 : CARDINAL; wp : WindowPtr);
VAR
n,X1,X2,Y1,Y2 : INTEGER;
pts : ARRAY [0..42] OF INTEGER;
xa,xb,ya,yb : CARDINAL;
BEGIN
X1:=CARDINAL(x1);
X2:=CARDINAL(x2);
Y1:=CARDINAL(y1);
Y2:=CARDINAL(y2);
pts[0]:=17; pts[1]:=7; pts[2]:=15; pts[3]:=17; pts[4]:=6; pts[5]:=15;
pts[6]:=8; pts[7]:=5; pts[8]:=3; pts[9]:=7; pts[10]:=4; pts[11]:=3;
pts[12]:=6; pts[13]:=3;pts[14]:=3; pts[15]:=5;pts[16]:=2; pts[17]:=3;
pts[18]:=8; pts[19]:=1;pts[20]:=26;pts[21]:=9;pts[22]:=0; pts[23]:=27;
pts[24]:=0; pts[25]:=2;pts[26]:=18;pts[27]:=(-4);pts[28]:=3; pts[29]:=13;
pts[30]:=(-4);pts[31]:=4;pts[32]:=13;pts[33]:=(-5);pts[34]:=5; pts[35]:=11;
pts[36]:=(-6);pts[37]:=6;pts[38]:=9; pts[39]:=(-8);pts[40]:=7; pts[41]:=5;
FOR n:= 0 TO 41 BY 3 DO
xa:=CARDINAL(X1-pts[n]);
ya:=CARDINAL(Y1-pts[n+1]);
xb:=CARDINAL(X1-pts[n]+pts[n+2]);
yb:=CARDINAL(Y1-pts[n+1]);
DrawLine(xa,ya,xb,yb,3,wp);
xa:=CARDINAL(X1-pts[n]);
ya:=CARDINAL(Y1+pts[n+1]);
xb:=CARDINAL(X1-pts[n]+pts[n+2]);
yb:=CARDINAL(Y1+pts[n+1]);
DrawLine(xa,ya,xb,yb,3,wp);
END;
pts[0]:=2; pts[1]:=7; pts[2]:=1; pts[3]:=2; pts[4]:=6; pts[5]:=1;
pts[6]:=(-10); pts[7]:=1; pts[8]:=1; pts[9]:=(-9); pts[10]:=0; pts[11]:=3;
FOR n:= 0 TO 11 BY 3 DO
xa:=CARDINAL(X1-pts[n]);
ya:=CARDINAL(Y1-pts[n+1]);
xb:=CARDINAL(X1-pts[n]+pts[n+2]);
yb:=CARDINAL(Y1-pts[n+1]);
DrawLine(xa,ya,xb,yb,2,wp);
xa:=CARDINAL(X1-pts[n]);
ya:=CARDINAL(Y1+pts[n+1]);
xb:=CARDINAL(X1-pts[n]+pts[n+2]);
yb:=CARDINAL(Y1+pts[n+1]);
DrawLine(xa,ya,xb,yb,2,wp);
END;
pts[0]:=17; pts[1]:=7; pts[2]:=12; pts[3]:=17; pts[4]:=6; pts[5]:=13;
pts[6]:=14; pts[7]:=5; pts[8]:=11; pts[9]:=13; pts[10]:=4; pts[11]:=11;
pts[12]:=12;pts[13]:=3;pts[14]:=11; pts[15]:=11;pts[16]:=2; pts[17]:=11;
pts[18]:=12;pts[19]:=1;pts[20]:=30;pts[21]:=12;pts[22]:=0; pts[23]:=30;
pts[24]:=(-12);pts[25]:=2;pts[26]:=5;pts[27]:=(-13);pts[28]:=3; pts[29]:=3;
pts[30]:=(-14);pts[31]:=4;pts[32]:=1;
FOR n:= 0 TO 32 BY 3 DO
xa:=CARDINAL(X2+pts[n]);
ya:=CARDINAL(Y2-pts[n+1]);
xb:=CARDINAL(X2+pts[n]-pts[n+2]);
yb:=CARDINAL(Y2-pts[n+1]);
DrawLine(xa,ya,xb,yb,3,wp);
xa:=CARDINAL(X2+pts[n]);
ya:=CARDINAL(Y2+pts[n+1]);
xb:=CARDINAL(X2+pts[n]-pts[n+2]);
yb:=CARDINAL(Y2+pts[n+1]);
DrawLine(xa,ya,xb,yb,3,wp);
END;
pts[0]:=18; pts[1]:=7; pts[2]:=1; pts[3]:=18; pts[4]:=6; pts[5]:=1;
pts[6]:=3; pts[7]:=1; pts[8]:=1; pts[9]:=3; pts[10]:=0; pts[11]:=1;
FOR n:= 0 TO 11 BY 3 DO
xa:=CARDINAL(X2+pts[n]);
ya:=CARDINAL(Y2-pts[n+1]);
xb:=CARDINAL(X2+pts[n]-pts[n+2]);
yb:=CARDINAL(Y2-pts[n+1]);
DrawLine(xa,ya,xb,yb,2,wp);
xa:=CARDINAL(X2+pts[n]);
ya:=CARDINAL(Y2+pts[n+1]);
xb:=CARDINAL(X2+pts[n]-pts[n+2]);
yb:=CARDINAL(Y2+pts[n+1]);
DrawLine(xa,ya,xb,yb,2,wp);
END;
END DrawShip;
END GW.